COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C***** BEAMS,  XNOTE, BAUTO, UPDATE, SLEND, POSIT *******
C00034 ENDMK
C⊗;
C***** BEAMS,  XNOTE, BAUTO, UPDATE, SLEND, POSIT *******
	SUBROUTINE BEAMS
	INTEGER UPDN
	COMMON/XRN/RN(2000)
	COMMON/RINP/R(10,80),POSNT(0/99) /RMOD/RMODE2,SET4,IBEAM,
	1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,IT,POS
	1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
	1 /PTR/PWDS(250),ITEM,LL,IS,IX
	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	COMMON R2,JAZ,CENTR,JBZ,RJQ(20),JQ(20) /STF/RSTFAC(8),RSTJ2
	COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
	1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
	DATA BX/25./,BY/.5/,DFAC/6./,CURV/0.9/
C  THESE ARE USED TO DETERMINE CURVE OF SLURS AT 63 (21700)

	IF(RMODE.LT.500)GO TO 251
	IF(MODE.EQ.4)RETURN
C  PICKS UP SLURS ONLY WHEN USING SUBR. 'EXTRA' *********
251	INVT=-1
	IF(MODE.EQ.3)GO TO 25
	IF(MODE.EQ.5)NTC=NTC-1
C  NTC=NUM OF NTS NOW
	IF(REND.NE.0)GO TO 25
	REND=3
25	DO 1500 K=1,72
	IF(INP(K).EQ.'B')GO TO 22
C  B=AUTOMATIC BEAMS.
	IF(INP(K).NE.'*')GO TO 1500
15	INP(72)='*'
	GO TO 500
1500	IF(INP(K).EQ.ISEMI)GO TO 500
	GO TO 15
C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
22	REREAD F78F,A,RB,RC
C  TYPE '2B' OR '3B' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
	IF(IREAD.NE.-1)GO TO 2222
	A=RB
	RB=RC
C  IREAD=-1 WHEN READING SOS FILES. (=-2 WITH ET FILES.)
2222	A=A/2.
C  '2'=1  '3'=1.5   '2B 3;'  MEANS THERE'S A 3 NOTE PICK-UP.
	IF(STEM)STEM=0
C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
	N=0
	J=0
	INP(72)='*'

	GR=4./88.
	NN=0
	NZ=0
	NL=1
	NJ=0
	NR=1
	JV=0
C  JV IS VX COUNTER
	C=0
	B=A-.001
	IF(RB.EQ.0)GO TO 122
	J=RB
C RB=NUM OF PICKUP ITEMS.*******(NTS AND RSTS - BUT NOT GRACE NTS.)*******
	B=-.001
	DO 222 K=1,J
222	IF(V(K).NE.GR)B=B+ABS(V(K))
C  ABOVE FOUND VALUE OF PICKUPS
122	X=ABS(V(NR))
	IF(X.NE.GR)GO TO 2122
	NN=NN+1
	GO TO 2022
2122	C=C+X
C  ADD ON RHYTH VALUE -- IF NOT GRACE NOTES
	IF(V(NR))N=N+1
C  FINDS RESTS AND GRACE NOTES (WE SKIP THEM)
	IF(C.GT.B)GO TO 822
CC	IF(NOTAIL(X))NL=NR
2022	IF(NR.EQ.IRHY)GO TO 422
922	NR=NR+1
C  NR=RIGHT SIDE OF BEAM, NL=LEFT
	GO TO 122
CC***822	IF(NR-NL-NN-N.GE.0)GO TO 322
822	IF(NR-NL-NN-N.GT.0)GO TO 322
C  IGNORE IF ONLY ONE NOTE FILLS UNIT
CC	N=NN+N
C  UPDATE REST AND GRACE COUNTER
722	IF(NR.EQ.IRHY)GO TO 422
	NN=0
	NJ=NJ+N
	NZ=NJ  
	N=0
	NL=NR+1
C PUSH AHEAD FOR NEXT BEAM
622	B=B+A
C UPDATE SPACE POINTER
	IF(C.GT.B)GO TO 622
	GO TO 922

322	KR=0
	NX=0
2322	IF(V(NL).NE.GR)GO TO 3322
C AVOIDS LEADING GRACE NOTES
	NL=NL+1
	GO TO 2322
3322	K=NL
	DO 522 J=K,NR
	X=V(J)
CC	IF(X.GT.0)GO TO 1822
	IF(X)NX=NX+1
C LOCAL COUNTER FOR RESTS.
CC	GO TO 1622
1822	IF(NOTAIL(X))GO TO 6622
C  X≤ 10.  8.  8..
	IF(X.GE.0)KR=J-NX
C  RIGHT SIDE OF BEAM
1622	IF(J.NE.NR)GO TO 522
C ALWAYS STOP ON LAST OF GROUP
6622	IF(KR.GT.NL)CALL BAUTO(JV,NL,KR,NZ)
	NZ=NZ+NX
	KR=0
  	NX=0
	NL=J+1
522	CONTINUE
	GO TO 722
C  MAIN AUTO BEAM LOOP ↑↑↑↑

C  NEXT FOR BEAMED GRACE NOTES
422	N=0
	J=1
1122	X=V(J)
	IF(X)N=N+1
	NR=0
	IF(X.NE.GR)GO TO 1022
	NL=J
	DO 1222 K=J,IRHY
	X=V(K)
	IF(X.OR.X.NE.GR)GO TO 1322
C  STOPS GRACE NOTE BEAM AT REST OR NON-GRACE
1222	NR=K
1322	IF(NR-NL.LE.0)GO TO 1022
	CALL BAUTO(JV,NL,NR,N)
C UPDATE VX COUNTER
	NL=NL+1
	J=NR
1022	J=J+1
	IF(J.LE.IRHY)GO TO 1122

1422	IF(JV.EQ.0)RETURN
C  NO BEAMS - SO GO BACK.
	DO 2822 K=JV+1,50
C  USES ONLY 68 SLOTS IN 'V'
2822	VX(K)=0
	J=0
	GO TO 511

C  *******  1ST MAIN LOOP *********
500	REREAD F78F,VX
	J=0
	IF(IREAD.EQ.-1)J=1
C  SKIPS LINE #S IN SOS FILES. (=-2 IS FOR ET FILES.)
511	J=J+1
	N=VX(J)
	JMP=1
	JREP=-1
C  JREP IS FOR REPEAT FEATURE IN 'MARKS'
505	L=0
	K=0
	POS=-10.
	IF(MODE.EQ.3)GO TO 5032
C  MODE 3 IS FOR ACCENTS ETC.
	RN(8+IS)=0
	RN(9+IS)=0
	IT=0
	UPDN=0
	IF(MODE.EQ.5)GO TO 104
	IF(STEM.EQ.0)GO TO 503
C  UPDN=2=STEMS DOWN, (SLUR DIP UP)  =1, OPPOSITE.
104	JA=J+1
	B=VX(JA)
C THE 2ND NOTE (-=DIP DOWN ALWAYS; +100=UP ALWAYS, ORD.=AUTOMATIC)
	IF(B.LT.100)GO TO 512
	UPDN=2
	B=B-100
	IF(B.GT.100)B=100-B
C  TYPE -NUM OR 200+NUM FOR DIP DOWN.
512	IF(B)UPDN=1
	VX(JA)=B
	RN(9+IS)=0
	BRK=AMOD(VX(J),1.)*10.
	IF(BRK.EQ.0)GO TO 503
C ADDS NUM TO BRACK. OR BEAM. ADD DESIRED .NUM TO 1ST NUM.(1.3=3)
	RN(9+IS)=BRK+.0001
	GO TO 5030
503	IF(N.GT.0)GO TO 5031
	IT=-1
C6/75	POS=-1.3
	CALL SLEND
C  -1= SLUR INTO 1ST NOTE.
C  SETS POS OF LFT SIDE (-10+9, THEN +2)
	GO TO 5060
5031	IF(N.LE.NTC)GO TO 5030
C  NTC=NUM OF NTS
C6/75	POS=202
	CALL SLEND
C  SLEND CHECKS ON END POINTS OF THIS STAFF
	GO TO 504
C  -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
5032	IF(N.GT.IRHY)N=IRHY
C TRAPS ERROR OF TRYING TO PUT MARK ON NON-EXISTENT NOTE.
5030	L=L+1
502	K=K+1
	IF(R(1,K).NE.1.)GO TO 502
C  IS IT A NOTE?
	P=R(3,K)
	IF(P.EQ.POS)GO TO 502
C  SKIPS DBLSTPS
	POS=P
506	IF(L.LT.N)GO TO 5030
5060	IF(MODE.EQ.3)GO TO 30
C  NOW SLUR STARTS
	IF(JMP)GO TO 504
C  JMP=-1 MEANS END NOTE OF GROUP
	J=J+1
	NN=VX(J)
C  IF 2ND NUM IS .LE. 1ST , THEN 2-NOTE SLUR. (-1 GOES TO 1)
	IF(NN.EQ.0)NN=N+1
	IF(NN.EQ.0)NN=1
	IF(NN)GO TO 777
	IF(NN.LE.N)NN=N+1
C  FOR USE WITH AUTO-BEAMS OR DIP UP.  2-NOTE SLUR OR BEAM UP.
777	IF(MODE.NE.4)GO TO 5061
	IF(STEM.LE.0)GO TO 5061
C  AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
177	MK=K
877	IF(R(1,MK).EQ.1)GO TO 477
	MK=MK+1
	GO TO 877
C  FOR SLUR INTO FIRST NOTE WITH AUTO BEAMS.
477	IF(R(10,MK).EQ.0)GO TO 1077
C SKIP NOTES ON ANOTHER STAFF.
	MK=MK+1
	GO TO 477
1077	A=19.-R(5,MK)
	IF(NN.GE.0)GO TO 277
	IF(A.GT.0)GO TO 377
277	IF(A.GE.0)GO TO 5061
	IF(NN.LE.0)GO TO 5061
377	NN=-NN
5061	MK=N
	N=IABS(NN)
	M=K
	JA=3
	JB=4
	KN=K
	RB=0
	IF(MODE.EQ.4)GO TO 550
	IBR=6
C  6=SLUR, 7=BRACK. FOR TRIPLETS, ETC.
CC*** NOT NEEDED NOW WITH UPDN FEATURE.	IF(STEM.GE.0)NN=-NN
	IF(IT)GO TO 550
C  IT=-1=SLUR INTO 1ST NOTE.
	A=XNOTE(K)
C XNOTE IS AMOD(R(4,K),100.)
C  SAVES LEVEL OF 1ST NOTE.
504	RB=2
CS	B=AMOD(R(6,K),1.0)
CS	IF(B.GE.0.5)RB=3.
CS	IF(B.EQ.0.4)RB=5.
C   THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
	IF(NN)RB=-RB
C  DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
550	RN(JA+IS)=POS
	B=XNOTE(K)
	IF(MODE.EQ.4)GO TO 519
C  TO MAKE MINI-BEAMS ON GRACE NOTES WHEN NEEDED.
	IF(MODE.NE.5)GO TO 513
	SLUR=0
C A FLAG FOR LATER USE.
	MB=R(5,K)/10.
	IF(UPDN.EQ.0)GO TO 515
	IF(MB.EQ.0)MB=UPDN
C  MB=0 IF 2ND NOTE IS WITHOUT STEM
	IF(MB.EQ.UPDN)GO TO 515
	X=6
	IF(NN)X=-X
CS	IF(RB)X=-X
	RB=RB+X
	JA=3
	IF(JMP)JA=6
	IF(NN)GO TO 204
CS	IF(RB)GO TO 204
	IF(UPDN.EQ.2)GO TO 516
204	IF(UPDN.EQ.1)GO TO 516
C  ABOVE FOR VARIOUS COMBINATIONS OF STEM DIRECTIONS
	RB=-RB
	NN=-NN
516	IF(K.GT.1)GO TO 16
	IF(IT)GO TO 513
16	IF(K.NE.NTC)GO TO 116
	IF(N.GT.NTC)GO TO 513
C JUMP IF N=99, BY PASS IF K IS NOT LAST NOTE OF LINE.
116	SLUR=1.
	IF(UPDN.EQ.1)SLUR=-SLUR
	SLUR=SLUR*RSTJ2
	RN(JA+IS)=RN(JA+IS)+SLUR
C  THIS NOT DONE IF SLUR TO FIRST NOTE
	GO TO 513
519	SDIF=R(10,K)
	IF(SDIF.EQ.0)GO TO 513
C JUMP IF IT'S NOT ON DIFF STF.
	RA=RSTJ2*2.44
C  NOTE WIDTH
	IF(ABS(R(4,K)).LT.80)GO TO 520
	RA=RA*.6
	IF(JMP)B=B-100
C  MINI
520	IF(SDIF.EQ.2)RA=-RA
C  STAFF ABOVE
	RN(JA+IS)=POS+RA
C  ***** THIS CAN BE OFF A LITTLE IN SOME CASES!!******
	SDIF=SDIF*5
	IF(SDIF.NE.10)SDIF=20
CHANGES 1 TO 20, 2 TO 10.
	GO TO 513


517	IF(MB.EQ.1)GO TO 513
	IF(RB)RB=-RB
	GO TO 518
515	UPDN=MB
C AUTO SLUR DIP DEPENDS ON STEM DIREC. OF 1ST NOTE. (WHOLE NTS??)
	IF(NN)GO TO 517
	IF(MB.NE.1)GO TO 513
	RB=-RB
518	NN=-NN
513	RN(JB+IS)=B+RB
C  MK=# OF 1ST NOTE, N=END NOTE NOW
	JMP=-JMP
	IF(JMP.GT.0)GO TO 1503
C  GO FIND RT. SIDE OF SLUR
	JA=6
	JB=5
	IF(N.LE.MK)N=MK+1
C  PICKS UP TYPO ERRORS
	JK=0
	IF(R(7,K).GE.10)JK=-1
C  CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
	GO TO 503

1503	RN(2+IS)=STAFF
	IF(MODE.EQ.4)GO TO 35
C NEXT TO SHIF SLUR IN RE. TO MARKS. STAC., TEN., ACC.
C ***********KN = 1ST NOTE, K=LAST NOTE.********
	JA=KN
	JB=4
2503	RB=R(2,JA)
	IF(RB.EQ.0)GO TO 3503
	IF(RB.EQ.4.OR.RB.EQ.5)GO TO 4503
	IF(RB.NE.7.AND.RB.NE.9)GO TO 3503
	RB=1.5
 	IF(R(5,JA).LT.20)RB=-RB
	RN(IS+JB)=RN(IS+JB)+RB
	GO TO 3503
4503	L=R(9,JA)
C THE POINTER TO P11 WAS SAVED HERE BY 'NEWR'
	RN(L)=RN(L)+.2
3503	IF(JA.EQ.K)GO TO 5503
	JA=K
	JB=JB+1
	GO TO 2503

5503	RN(8+IS)=-1
	RN(1+IS)=5
	IF(IT)RN(4+IS)=RN(5+IS)
	NN=-NN
C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
	IF(MK.EQ.IRHY)GO TO 61
	IF(N.EQ.1)GO TO 61
	IF(IT)GO TO 60
	IF(XNOTE(K).NE.A)GO TO 60
	IF(N-MK.GT.1)GO TO 60
CCC	IF(R(5,M).NE.R(5,K))GO TO 65
CCC  FOR SLUR OVER CHROMATIC CHANGE ON SAME NOTE NAME.
C  M=1ST NOTE OF SLUR, K=LAST
	IF(AMOD(R(5,K),10.0).GT.0)GO TO 65
C  JUMP IF LAST NOTE AS ACCI.
C  JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
61	C=9
	IF(JK)C=12
	IF(RN(6+IS)-RN(3+IS)-C*RSTJ2)GO TO 65
C  JUMP IF SLUR IS VERY SHORT
	IF(IT)A=XNOTE(K)
C  IT=-1=SLUR INTO 1ST NOTE.
	A=A+.7
	IF(NN.GT.0)A=A-1.4
C  TO RAISE OR LOWER IT .5
	RN(4+IS)=A
	RN(5+IS)=A
	B=-2
	IF(JK)B=-3
C  JK=-1 WHEN NOTE IS DOTTED.
C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
	RN(8+IS)=B
	IF(SLUR.EQ.0)GO TO 65
	RN(3+IS)=RN(3+IS)-SLUR
	RN(6+IS)=RN(6+IS)-SLUR
C  PUSH SLUR BACK TO WHERE IT WAS
	GO TO 65

C** 6/16/75 60	IF(STEM.GE.0)GO TO 508
60	IF(STEM.GE.0)GO TO 200
	IF(MODE.EQ.5)GO TO 200
C  JUMP IF SLURS**************
C  NEXT IS STEM INVERTER.  SKIP IF AUTOMATIC BEAMS OR 'SU' 'SD' IN USE.
	JB=1
	RB=10.
	IF(NN)GO TO 509
C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
	RB=-RB
	JB=2
509	DO 507 L=M,K
	IF(R(1,L).NE.1.)GO TO 507
	JA=R(5,L)/10.
	IF(JA.NE.JB)GO TO 507
	IF(R(10,L).NE.0)GO TO 507
C LEAVE NOTE ON OTHER STAFF ALONE.
	R(5,L)=R(5,L)+RB
	INVT=0
C**********************************************
507	CONTINUE
	GO TO 200
62	IF(NN)GO TO 64
	IF(A.EQ.DMAX)GO TO 65
	AA=B-DMAX
	GO TO 63
65	AA=0
	GO TO 63
64	IF(A.EQ.UMAX)GO TO 65
	AA=UMAX-B
63	RA=RN(6+IS)
	RB=RN(3+IS)
	X=CURV+(RA-RB)/BX+ABS(RN(4+IS)-RN(5+IS))/10.
C  CURVE DEPENDS ON LENGTH, TILT AND NOTES BETWEEN.
	IF(AA.GT.0)X=X+AA*BY
	IF(BRK.EQ.0)GO TO 66
	RN(8+IS)=1
	RN(3+IS)=RB-.6
	RB=R(3,K+1)
C  K=END NOTE OF GROUP
	IF(K.EQ.IZ)RB=200.
C IZ IS LAST ITEM IN R(N,M)
C****	IF(K.EQ.IRHY)RB=200.
C  ASSUMES LINE STOPS AT 200. (IT COULD BE LONGER!!)
	RN(6+IS)=RA+(RB-RA)/2.
	IBR=7
C  CHECK THESE NUMBERS↑↑↑↑
	B=RN(4+IS)
	BB=RN(5+IS)
	RA=1
	IF(A.LT.-1)RA=2.5
C  CHANGES HEIGHT.  MAKES BRACK. IF N>100.
	IF(NN.GT.0)RA=-RA
	RN(4+IS)=B+RA
	RN(5+IS)=BB+RA
	X=2
66	IF(NN.GT.0)X=-X
510	RN(7+IS)=X
	IF(MODE.NE.4)GO TO 2514
CC	RN(9+IS)=0
	RN(10+IS)=0
	RN(IS+11)=-1
	CALL UPDATE(9)
	IF(JB)CALL BMX(RA)
	GO TO 514
2514	L=IS
	CALL UPDATE(IBR)
	IF(M.EQ.K)GO TO 514
C JUMP OUT IF INTERVENING NOTE.
	IF(RN(L+4).NE.RN(L+5))GO TO 514
C  IS IT LEVEL?
	B=-RN(IS-2)
C CHANGE DIRECTION OF DIP AFTER FIRST SLUR.
	RA=1.4
	IF(RN(L+8).EQ.-1)RA=RA+1.3
C  IS TIE NOT BETWEEN NOTES?
	IF(NN.GT.0)RA=-RA
C DIP DIRECTION.  NN+ =DOWN, NN- =UP.  REVERSED AFTER 1ST ONE.
	RA=XNOTE(M)+RA
	C=-2.
	IF(RN(L+8).EQ.-3.)C=-3.
C PUT TIE BETWEEN NOTES ALWAYS.
	JA=M
	JB=K
114	JA=JA+1
	JB=JB+1
	IF(R(3,JB).NE.POS)GO TO 514
C JUMP IF RIGHT-HAND NOTE NOT IN SAME POS.
	IF(R(1,JA).NE.1)GO TO 514
C  CATCHES THINGS BETWEEN NOTES
	IF(R(4,JA).NE.R(4,JB))GO TO 514
C  LOOKS FOR  PARALLEL CHORDS NOTES
CRH	IF(R(9,JA)+R(9,JB).NE.0)GO TO 514
C  MAKES SURE THEY ARE CHORD NOTES.
	A=XNOTE(JA)-RA+RN(L+5)
	RN(IS)=6.
	RN(IS+1)=5.
	RN(IS+2)=RN(IS-7)
	RN(IS+3)=RN(IS-6)
	RN(IS+6)=RN(IS-3)
	RN(IS+7)=B
	RN(IS+8)=C
	RN(IS+4)=A  
	RN(IS+5)=A  
	CALL UPDATE(IBR)
	GO TO 114
514	J=J+1
	A=VX(J)
	N=A
C  SO ITEMS NEED NOT BE IN RIGHT ORDER.
	IF(MOD(N,100).GT.IRHY)A=0
	IF(A.NE.0)GO TO 505
CC***USE NO NUMBS IN COMMENTS IN MODE 3-5******	IF(VX(J+2).EQ.0)GO TO 614
	IF(J.LT.50)GO TO 514
C  SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
614	IF(INP(72).NE.'*')GO TO  552
	IF(INVT)RETURN
	INVT=IS
	CALL NEWR
	IS=INVT
	RETURN
552	IF(IREAD.NE.0)GO TO 3501
	CALL TYPE
	WRITE(21,4501)INP
	GO TO 5501
3501	IF(IREAD.EQ.-1)READ(22,2501)J,INP
	IF(IREAD.EQ.-2)READ(22,4501)INP
	CALL TYPOUT
5501	CALL LNEND
C  FOR NEW 'SCORE' CONVENTIONS
C  TO READ MORE THAN 2 LINES.
	GO TO 25
C  FOR 2ND LINE.
4501	FORMAT(72A1)
2501	FORMAT(I,72A1)


35	RA=10.
C  RA WILL=# OF TAILS,  KN=1ST NOTE, K=LAST ('MOD' FOR DOTTED NOTES.)
	RN(1+IS)=6
	JMAX=0
	IF(N-MK.EQ.1)JMAX=-1
	DMAX=100.
	UMAX=-DMAX
C  FOR AUTO. BEAMS

	JB=0
	MB=0
C MB=-1 =GRACE NOTES UNDER BEAMS.  
	IF(ABS(R(4,KN)).GE.80.)MB=-1
	DO 2 L=KN,K
	IF(R(1,L).NE.1)GO TO 2
	IF(R(10,L).NE.0)GO TO 2
C SKIP NOTES ON ANOTHER STAFF.
	BB=R(5,L)
	IF(BB.GE.10.)GO TO 12
	UPDN=-1
	NN=19-AA
CHORDS WILL HAVE FIXED STEM DIRECTIONS ALWAYS
	GO TO 2
C  SKIPS NON-NOTES AND DBLSTPS
12	IF(MB)GO TO 10
	AA=BB
	RB=R(4,L)
	IF(ABS(RB).GE.80)GO TO 2
C  SKIPS GRACE NOTES
	GO TO 110
10	RB=XNOTE(L)
110	IF(RB.GT.UMAX)UMAX=RB
	IF(RB.LT.DMAX)DMAX=RB
C  FOR AUTO. BEAMS
	RB=AMOD(R(7,L),10.0)
112	IF(RA.EQ.RB)GO TO 2
	JB=-1
C   FLAG FOR MIXED NUM. OF BEAMS
	IF(RB.GE.RA)GO TO 2
	IF(RB.NE.0)RA=RB
2	CONTINUE
C  ABOVE FINDS SMALLEST # OF TAILS.  NEXT FOR HGTS.
C  ABOVE IS POS.2
	IT=K
C  FOR EXTRA BEAMS WITH CHORDS. SAVE IT IN "IT"
	IF(STEM.GT.0)GO TO 577
C  *****↑↑↑↑↑↑ ABOVE WAS ".NE." BEFORE 4/30/76. WHY?#@&Xαε
	IF(UPDN.NE.0)GO TO 577
	IF(UMAX+DMAX.GE.14)NN=-1
CXX	IF(STEM.GT.0)NN=10.-STEM
C  SETS AUTO. BEAMS' STEM DIRECTION.
577	X=10
	IF(NN)X=20
	IF(SDIF.NE.0)X=SDIF
	IF(MB)RA=2
C  2 BEAMS ON GRACE NOTES ALWAYS
	X=X+RA
C  # OF BEAMS.  IT'S PUT IN  DOWN BELOW 550.
200	M=KN
207	L=M+1
	IF(R(1,L).NE.1)GO TO 307
CC	IF(R(9,L).NE.0)GO TO 307
	IF(R(5,L).GE.10)GO TO 307
	M=M+1
	GO TO 207
C  FOR HEIGHTS OF DBL STPS, ETC.
307	IF(R(10,M).EQ.0)GO TO 607
	M=M+1
C SKIP NOTES ON OTHER STAFF
	GO TO 307
607	A=XNOTE(M)
CW307	A=XNOTE(M)
C   A=NOTE 1.
	UMAX=A
	DMAX=A
C  UP MAX. NOTE #, DOWN MAX. NOTE #.
407	M=K+1
	IF(R(1,M).NE.1)GO TO 103
CC	IF(R(9,M).NE.0)GO TO 103
	IF(R(5,M).GE.10)GO TO 103
C  FINDS DBL+ STP ON LAST OF BEAM
	K=M
	GO TO 407
103	DO 3 M=KN,K
	IF(R(1,M).NE.1)GO TO 3
	IF(R(10,M).NE.0)GO TO 3
C SKIP NOTES ON OTHER STAFF
	IF(M.EQ.K)GO TO 107
CW	IF(R(10,M).NE.0)GO TO 107
	IF(R(1,M+1).NE.1)GO TO 107
C IT ONLY CARES ABOUT NOTES!
CC	IF(R(9,M+1).EQ.0)GO TO 3
	IF(R(5,M+1).LT.10)GO TO 3
C IGNORE LOWER (OR UPPER) NOTES OF CHORDS (NO STEM)-IN RE. UP-DOWN FEATURE.
107	IF(MB)GO TO 7
C  SKIP IF DEALING WITH GRACE NOTE BEAMS. (MB=-1)
	IF(ABS(R(4,M)).GE.100)GO TO 3
C  SKIPS NON-NOTES
7	B=XNOTE(M)
	IF(MODE.EQ.5)GO TO 55
677	IF(R(10,M).NE.0)GO TO 55
C  DON'T CHANGE STEM DIR. IF NOTE IS ON OTHER STAFF!!!!
	STMDR=R(5,M)
	IF(NN.GT.0)GO TO 5
C  JUMP IF STEM UP
	IF(STMDR.GE.20.)GO TO 55
	IF(STMDR.LT.10.)GO TO 55
	R(5,M)=STMDR+10.
	GO TO  551
5	IF(STMDR.LT.20.)GO TO 55
	R(5,M)=STMDR-10.
C************************
C    STEM UP
551	INVT=0
55	IF(B.LE.UMAX)GO TO 13
C ↑↑↑↑↑↑↑↑ WAS .LT. !!!!! 5/76
	UMAX=B
	IF(JMAX)GO TO 3
	IF(M.EQ.KN)GO TO 3
	IF(M.EQ.K)GO TO 3
	UMAX=UMAX+1
	GO TO 3
13	IF(B.GT.DMAX)GO TO 3
	DMAX=B
	IF(JMAX)GO TO 3
	IF(M.EQ.KN)GO TO 3
	IF(M.EQ.K)GO TO 3
	DMAX=DMAX-1
3	CONTINUE
C  LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
4	IF(MODE.EQ.5)GO TO 62
	K=IT
C  FOR EXTRA BEAMS WITH CHORDS. K WAS SAVED IN "IT"
	AA=A
	BB=B
	C=1
	IF(X.LT.20.)GO TO 48
C  JUMP IF STEM IS UP
	CALL EXCH(AA,BB)
	C=-C
	CALL EXCH(UMAX,DMAX)
48	IF(AA.LT.BB)GO TO 45
	IF(UMAX.EQ.A)GO TO 46
47	A=UMAX-C
	B=A
	GO TO 444
46	IF(UMAX.GT.AA)GO TO 47
	GO TO 49
45	IF(UMAX.NE.B)GO TO 47
49	A=AA
	B=BB
	IF(X.GE.20)CALL EXCH(A,B)

444	RN(2+IS)=STAFF 
446	DIS=(RN(IS+6)-RN(IS+3))/DFAC
C  FOR TILT LATER -- DFAC IS IN DATA
	IF(ABS(A-B).LT.DIS)GO TO 143
	C=C*DIS
C  NEW TILT ROUTINE.  CONSIDERS DISTANCE:HEIGHT
C  LIMITS SLOPE OF BEAM
	IF(X.GE.20)GO TO 141
	IF(B.GT.A)GO TO 140
142	B=A-C
	GO TO 143
141	IF(B.GT.A)GO TO 142
140	A=B-C

143	BB=A
	IF(STMDR.GE.20)GO TO 530
	IF(B.LT.A)BB=B
C BB IS LOWEST SIDE OF BEAM
	IF(BB.GE.-2)GO TO 14
CC	IF(BB.GE.-2)GO TO 330
C  THIS COULD BE -1.  SEE NOTES
	BB=-BB-2
430	A=A+BB
	B=B+BB
C  GET NEW HEIGHT NUMBERS.
	GO TO 14
CC	GO TO 330
530	IF(B.GT.A)BB=B
C FOR STEMS DOWN
CC	IF(BB.LE.16)GO TO 330
	IF(BB.LE.16)GO TO 14
C  THIS COULD BE 15.
	BB=16-BB
	GO TO 430

14	IF(MB.EQ.0)GO TO 330
C NEXT FOR GRACE NOTE BEAMS (MB=-1)
	C=100
	IF(A)C=-C
	A=A+C
330	RN(4+IS)=A
	RN(5+IS)=B
C   MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
C*******??????	RN(6+IS)=R(3,K)
C  ABOVE IS POS.2
	GO TO 510

C   NEXT IS FOR ACCENTS AND OTHER MARKS

30	IF(JREP)CALL MARKS(RA)
	RB=0
C%%%%%%%%
	J=J+1
	IF(RA.GE.30.AND.RA.LE.35)VX(J+1)=0
C THIS  ↑↑↑↑ CATCHES FINGERING NUM.(0-5)  IT WAS READ IN MARKS.
	IF(RA.EQ.99)RA=VX(J)
C  IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
C    OF ACCENT WILL BE INVERTED.
130	IF(RA.LT.37)GO TO 304
C  37=RIT.
	NN=6
	BB=-6
	A=3
	B=3
	IF(XNOTE(K).LT.3)BB=XNOTE(K)-9.5
C LOWERS ITEM IF NOTE BELOW STAFF.  BUT IS 'K' ALWAYS OK HERE??????
	IF(RA.LT.99)GO TO 305
C NEXT FOR CRESC. & DECRSC. LINES<,>. TYPE /NT1 C+ NT2/ OR /N1.d  C- N2.d/
C ALSO FOR "8va ----" /NT1 O NT2/
	NN=8
	BB=BB+2.5
	A=5
	B=4
	RB=50
	IF(RA.NE.208)GO TO 306
	RB=0
	B=7
	BB=15
C  LATER ADD CHECK FOR HEIGHT OF NOTES UNDER 8va.
306	RN(IS+7)=RA-200
C  MAKES ZERO OR -1 OR 8 IN P7
	RA=RB
C  ADDS A NEW ITEM.  MP, PP, CRESC., ETC. --CODE 3
305	RN(IS)=A
	RN(IS+1)=B
	RN(IS+2)=STAFF
C  PUTS MF, ETC. BETWEEN NOTES.  (I HOPE)  SEE 'FUNCTION POSIT' BELOW
	RN(IS+3)=POSIT(VX(J-1))-1
C  '-1' PUSHES IT TO LEFT. MAYBE CHANGE ORIGINAL POSITIONS??
	RN(IS+4)=BB
C  DIST. BELOW STAFF
	RN(IS+5)=RA
C  THE CODE NUM IN 'CLEFS' LIST
	IS=IS+NN
	IF(NN.EQ.6)GO TO 230
	J=J+1
	RA=POSIT(VX(J))
	IF(RB.EQ.0)RA=RA+3
C RB=0= 8va
	RN(IS-2)=RA
C  THIS IS P6 (POS2 FOR CRESC. LINES)
	GO TO 514
CS304	RB=R(6,K)
CS	B=10.
CS	IF(RA.EQ.6)RA=26.
C TEMPORARY CHANGE FOR FERMATA*******
CS	IF(RA.GT.10.)RA=RA/10.
CS	A=ABS(AMOD(RB,1.))
CS	IF(A.EQ.0)GO TO 301
CS	IF(RA.GT.3)GO TO 303
CS	RB=FLOAT(IFIX(RB))
CS	RA=RA+A/10.
C  THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
CS	GO TO 301
CS303	IF(A.LT..3)GO TO 302
CS	B=100.
CS	GO TO 301
CS302	B=1000.
CS301	IF(RB.LT.0)RA=-RA
CS	R(6,K)=RB+RA/B
304	RB=R(2,K)
	IF(RA.EQ.6)RA=26.
	A=RA
	IF(RB.EQ.0)GO TO 301
	IF(RB.GE.10)GO TO 303
	A=A*100
	GO TO 301
303	RB=RB*100
301	R(2,K)=RB+A
C  P11 INFO(MARKS) IS TEMPORARILY STORED IN P2 (STAFF# IS IN STAFF)
230	A=VX(J)
	JREP=-1
	IF(A.EQ.0)GO TO 514
C NEXT FOR STRING OF SAME MARK ( /3 12 S/ )
	JREP=0
	J=J-1
	VX(J)=VX(J)+1
	IF(VX(J).GE.A)VX(J+1)=0
	J=J-1
	GO TO 514
C   USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
C  NOTE#,ACCENT#/N,A/N,A*
	END

CF	FUNCTION XNOTE(J)
CF	COMMON/XRN/RN(4000)
CF	DIMENSION R(10,80)
CF	EQUIVALENCE (R,RN(3001))
CF	XNOTE=AMOD(R(4,J),100.)
CF	END

CF	SUBROUTINE BAUTO(J,L,K,N)
C  FOR AUTOMATIC BEAMS.
CF	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
CF	J=J+2
CF	V(J-1)=L-N
CF	V(J)=K-N
CF	END

CF	SUBROUTINE UPDATE(I)
CF	COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
CF	RN(IS)=I
CF	IS=IS+I+3
CF	END

C	SUBROUTINE SLEND
C	INTEGER PWDS
C  TO FIND END POINTS OF STAVES
C	COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,DMAX,
C	1 UMAX,AA,JMAX,X,Y,BB,RNX(1982)
     1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
C	DO 1 K=1,ITEM
C	L=PWDS(K)
C	IF(RN(L+1).NE.8)GO TO 1
C  FOUND A STAFF
C	IF(RN(L+2).NE.STAFF)GO TO 1
C GOT THE RIGHT ONE
C	IF(IT)GO TO 2
C	POS=202
C NOW CHECK LEFT SIDE OF STAFF
C	IF(RN(L).LT.4)RETURN
C P6 WASN'T MENTIONED - SO IT =200
C	POS=RN(L+6)+2
C	IF(POS.EQ.2)POS=202
C	RETURN
C2	POS=RN(L+3)-2.3
C	RETURN
C1	CONTINUE
C	END

C	FUNCTION POSIT(V)
C	COMMON/XRN/RN(4000)
C	DIMENSION POSNT(0/82)
C	EQUIVALENCE (POSNT,RN(3801))
C	1,(A,RN(3884)),(K,RN(3885))
C	IF(V)V=-V
C  REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
C	K=V
C	A=POSNT(K)
C	POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
C  TYPE  /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
C	END